home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue40 / Alfresco / AACvRomn.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-31  |  5.7 KB  |  162 lines
  1. {*********************************************************}
  2. {* AACvRomn                                              *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Convert integers to/from Roman numbers                *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AACvRomn;
  14.  
  15. interface
  16.  
  17. function IntToRoman(aValue : integer) : string;
  18.   {-convert an integer between 1 and 3999 to a Roman number}
  19.  
  20. function RomanToInt(aValue : string) : integer;
  21.   {-convert Roman number to an integer}
  22.  
  23. implementation
  24.  
  25. uses
  26.   SysUtils;
  27.  
  28. const
  29.   RomanDigits : array [1..9] of string[4] =
  30.               ('I', 'II', 'III', 'IV', 'V', 'VI', 'VII', 'VIII', 'IX');
  31.   Roman10s : array [1..9] of string[4] =
  32.            ('X', 'XX', 'XXX', 'XL', 'L', 'LX', 'LXX', 'LXXX', 'XC');
  33.   Roman100s : array [1..9] of string[4] =
  34.             ('C', 'CC', 'CCC', 'CD', 'D', 'DC', 'DCC', 'DCCC', 'CM');
  35.   Roman1000s : array [1..3] of string[3] =
  36.              ('M', 'MM', 'MMM');
  37.  
  38.   RomanNumerals : string[7] = 'MDCLXVI';
  39.     {-The individual Roman numerals}
  40.  
  41.   RomanStateMc : array [0..17, 1..7] of word =
  42.       {Numeral:        M      D     C     L    X    V   I}
  43.       {State 0:} ((32001, 16004, 3205, 1609, 330, 174, 47),
  44.            { 1:}  (32002, 16004, 3205, 1609, 330, 174, 47),
  45.            { 2:}  (32003, 16004, 3205, 1609, 330, 174, 47),
  46.            { 3:}  (    0, 16004, 3205, 1609, 330, 174, 47),
  47.            { 4:}  (    0,     0, 3206, 1609, 330, 174, 47),
  48.            { 5:}  (25608,  9608, 3207, 1609, 330, 174, 47),
  49.            { 6:}  (    0,     0, 3207, 1609, 330, 174, 47),
  50.            { 7:}  (    0,     0, 3208, 1609, 330, 174, 47),
  51.            { 8:}  (    0,     0,    0, 1609, 330, 174, 47),
  52.            { 9:}  (    0,     0,    0,    0, 331, 174, 47),
  53.            {10:}  (    0,     0, 2573,  973, 332, 174, 47),
  54.            {11:}  (    0,     0,    0,    0, 332, 174, 47),
  55.            {12:}  (    0,     0,    0,    0, 333, 174, 47),
  56.            {13:}  (    0,     0,    0,    0,   0, 174, 47),
  57.            {14:}  (    0,     0,    0,    0,   0,   0, 48),
  58.            {15:}  (    0,     0,    0,    0, 287, 127, 49),
  59.            {16:}  (    0,     0,    0,    0,   0,   0, 49),
  60.            {17:}  (    0,     0,    0,    0,   0,   0, 63));
  61.     {-State machine table to convert from Roman numbers to integers.
  62.       Each entry is equal to (ValueToAdd * 32) + NextState for a
  63.       given State/Roman numeral.
  64.       State 0 is the initial state; state 31 is the terminator state.}
  65.  
  66.  
  67. {===Helper routines==================================================}
  68. procedure RaiseBadNumberError(aValue : integer);
  69. begin
  70.   raise EConvertError.Create(
  71.      Format('IntToRoman: cannot convert %d to Roman value', [aValue]));
  72. end;
  73. {--------}
  74. procedure RaiseEmptyStringError;
  75. begin
  76.   raise EConvertError.Create('RomanToInt: string is empty');
  77. end;
  78. {--------}
  79. procedure RaiseBadCharError(const S : string; C : char; aPosn : integer);
  80. begin
  81.   raise EConvertError.Create(
  82.      Format('RomanToInt: unknown character %s at position %d in "%s"',
  83.             [C, aPosn, S]));
  84. end;
  85. {--------}
  86. procedure RaiseBadRomanNumberError(const S : string; aPosn : integer);
  87. begin
  88.   raise EConvertError.Create(
  89.      Format('RomanToInt: "%s" is a badly formed Roman number at position %d',
  90.             [S, aPosn]));
  91. end;
  92. {====================================================================}
  93.  
  94.  
  95. {===Interfaced routines==============================================}
  96. function IntToRoman(aValue : integer) : string;
  97. var
  98.   Digit : integer;
  99. begin
  100.   if (aValue <= 0) or (aValue >= 4000) then
  101.     RaiseBadNumberError(aValue);
  102.   {get 1000s digit and convert}
  103.   Digit := aValue div 1000;
  104.   if (Digit <> 0) then
  105.     Result := Roman1000s[Digit]
  106.   else
  107.     Result := '';
  108.   {get 100s digit and convert}
  109.   aValue := aValue mod 1000;
  110.   Digit := aValue div 100;
  111.   if (Digit <> 0) then
  112.     Result := Result + Roman100s[Digit];
  113.   {get 10s digit and convert}
  114.   aValue := aValue mod 100;
  115.   Digit := aValue div 10;
  116.   if (Digit <> 0) then
  117.     Result := Result + Roman10s[Digit];
  118.   {get singles digit and convert}
  119.   Digit := aValue mod 10;
  120.   if (Digit <> 0) then
  121.     Result := Result + RomanDigits[Digit];
  122. end;
  123. {--------}
  124. function RomanToInt(aValue : string) : integer;
  125. var
  126.   i          : integer;
  127.   ChInx      : integer;
  128.   State      : integer;
  129.   StateValue : integer;
  130.   Ch         : char;
  131. begin
  132.   {we don't like empty strings}
  133.   if (aValue = '') then
  134.     RaiseEmptyStringError;
  135.   {initialise sum as zero; set initial state to 0}
  136.   Result := 0;
  137.   State := 0;
  138.   {for each letter in the string...}
  139.   for i := 1 to length(aValue) do begin
  140.     {if we're in the terminator state, we shouldn't get any more Roman
  141.      numerals, hence raise error}
  142.     if (State = 31) then
  143.       RaiseBadRomanNumberError(aValue, i);
  144.     {get the next character, check to see if it's valid}
  145.     Ch := UpCase(aValue[i]);
  146.     ChInx := Pos(Ch, RomanNumerals);
  147.     if (ChInx = 0) then
  148.       RaiseBadCharError(aValue, aValue[i], i);
  149.     {get the value to add, if it's zero we've got a badly formed Roman
  150.      number}
  151.     StateValue := RomanStateMc[State, ChInx];
  152.     if (StateValue = 0) then
  153.       RaiseBadRomanNumberError(aValue, i);
  154.     {increment the sum, set the next state}
  155.     inc(Result, StateValue div 32);
  156.     State := StateValue mod 32;
  157.   end;
  158. end;
  159. {====================================================================}
  160.  
  161. end.
  162.